home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / FAUG / FAUG05.ADF / polydraw.bas < prev    next >
BASIC Source File  |  1992-01-03  |  17KB  |  483 lines
  1. 1     rem *** POLYDRAW by David Addison ***
  2. 2     rem *** Version 1.2   C 1986 ***
  3. 5     clr:SCREEN 0,5:scnclr
  4. 10    DIM picture%(11000),regsave%(100),cset%(580),img1%(112),name$(19)
  5. 11    gosub 58000
  6. 12    vcset%=VARPTR(cset%(0)):vimg1%=VARPTR(img1%(0))
  7. 14    bload "polydraw_font",vcset%
  8. 20    filename$="polydraw_pic":x%=0:y%=0:gosub 17080
  9. 25    first%=11:last%=16:speed%=100:gosub 25070
  10. 30    scnclr
  11. 52    colorfile$="polydraw_reg_dat"
  12. 55    bload colorfile$,VARPTR(regsave%(0))
  13. 57    ct=0
  14. 59    FOR i% = 0 TO 31
  15. 61    rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  16. 63    ct=ct+3
  17. 65    NEXT i%
  18. 70    pena 1:FLAG% = 0:COUNT%=0
  19. 90    a$="?":goto 180
  20. 100   REM **** MAIN LOOP ****
  21. 110   GET a$
  22. 120   IF a$="D" OR a$="d" OR a$="D." THEN GOSUB 12000:goto 1000
  23. 125   IF a$="Z" OR a$="z" OR a$="Z." THEN GOSUB 21000:goto 1000
  24. 130   IF a$="B" OR a$="b" OR a$="B." THEN GOSUB 10000:goto 1000
  25. 135   IF a$="X" OR a$="x" or a$="X." THEN GOSUB 40000:goto 1000
  26. 140   IF a$="L" OR a$="l" or a$="L." THEN GOSUB 11000:goto 1000
  27. 145   IF a$="O" OR a$="o" or a$="O." THEN GOSUB 35000:goto 1000
  28. 150   IF a$="S" OR a$="s" or a$="S." THEN GOSUB 15000:goto 1000
  29. 155   IF a$="F" OR a$="f" or a$="F." THEN GOSUB 14000:goto 1000
  30. 160   IF a$="C" OR a$="c" or a$="C." THEN GOSUB 13000:goto 1000
  31. 165   IF a$="K" OR a$="k" or a$="K." THEN GOSUB 17000:goto 1000
  32. 170   IF a$="Q" OR a$="q" or a$="Q." THEN GOTO 16000
  33. 175   IF a$="U" OR a$="u" or a$="U." THEN scnclr:goto 1000
  34. 180   IF a$="?" OR a$="/" OR a$="?." THEN GOSUB 30000:goto 120
  35. 185   IF a$="E" OR a$="e" or a$="E." THEN GOSUB 36000:goto 1000
  36. 187   IF a$="R" OR a$="r" or a$="R." THEN GOSUB 37000:goto 1000
  37. 188   IF a$="A" OR a$="a" or a$="A." THEN GOSUB 52000:goto 1000
  38. 190   IF a$="T" OR a$="t" THEN getkey b$:GOSUB 41000:goto 1000
  39. 192   if a$="TB" or a$="TS" then b$=mid$(a$,2,1):gosub 41000:goto 1000
  40. 200   IF a$="M" OR a$="m" or a$="M." THEN GOSUB 25000:goto 1000
  41. 500   GOTO 110
  42. 1000  for i%=1 to 10:get a$:next i%:goto 110
  43. 9999  REM **** RUBBER BAND BOX ****
  44. 10000 talk$ = TRANSLATE$("BOX!"):q% = narrate(talk$)
  45. 10005 GOSUB 10040
  46. 10016 IF a$<>"" THEN 20000
  47. 10030 GOTO 10005
  48. 10040 drawmode 2
  49. 10050 ask MOUSE x1%,y1%,b%:GOSUB 50000
  50. 10060 GOSUB 55000
  51. 10065 if a$<>"" then return
  52. 10070 x2% = x1% : y2% = y1%
  53. 10080 ask MOUSE x%,y%,b%:GOSUB 50000
  54. 10090 IF x% = x2% AND y% = y2% GOTO 10080
  55. 10100 IF b%=0 THEN 10150
  56. 10110 box (x1%,y1%;x2%,y2%)
  57. 10120 x2% = x% : y2% = y%
  58. 10130 box(x1%,y1%;x2%,y2%)
  59. 10140 IF b% <> 0 GOTO 10080
  60. 10150 drawmode 0
  61. 10155 peno colreg%:box(x1%,y1%;x2%,y2%)
  62. 10160 RETURN
  63. 10999 REM **** RUBBER BAND LINE ****
  64. 11000 talk$ = TRANSLATE$("LINE!"):q% = narrate(talk$)
  65. 11005 GOSUB 11040
  66. 11010 ask MOUSE x%,y%,b%:GOSUB 50000
  67. 11015 GET a$:IF a$="C" OR a$="c" THEN GOSUB 13000:GOTO 11010
  68. 11016 IF a$<>"" THEN 20000
  69. 11020 IF b% = 0 GOTO 11010
  70. 11030 GOTO 11005
  71. 11040 drawmode 2
  72. 11050 ask MOUSE x1%,y1%,b%:GOSUB 50000
  73. 11060 IF b% = 0 GOTO 11050
  74. 11070 x2% = x1% : y2% = y1%
  75. 11080 ask MOUSE x%,y%,b%:GOSUB 50000
  76. 11090 IF x% = x2% AND y% = y2% GOTO 11080
  77. 11100 IF b%=0 THEN 11150
  78. 11110 draw (x1%,y1% TO x2%,y2%)
  79. 11120 x2% = x% : y2% = y%
  80. 11130 draw (x1%,y1% TO x2%,y2%)
  81. 11140 IF b% <> 0 GOTO 11080
  82. 11150 drawmode 0
  83. 11155 draw (x1%,y1% TO x2%,y2%)
  84. 11160 RETURN
  85. 11999 REM **** DRAW ****
  86. 12000 talk$ = TRANSLATE$("DRAWW!"):q% = narrate(talk$)
  87. 12005 ask MOUSE x%,y%,b%:GOSUB 50000
  88. 12010 GET a$:IF a$ = "C" OR a$="c" THEN GOSUB 13000 ELSE IF a$<>"" THEN 20000
  89. 12020 IF b% = 0 GOTO 12005
  90. 12030 draw (x%,y%)
  91. 12035 ask mouse x%,y%,b%:gosub 50000
  92. 12036 if b%=0 goto 12005
  93. 12037 draw (to x%,y%)
  94. 12040 goto 12035
  95. 12999 REM **** COLOR CHANGE ROUTINE ****
  96. 13000 WINDOW #1,220,0,100,64,"COLORS "
  97. 13010 cmd #1
  98. 13015 ON ERROR GOTO 60010
  99. 13020 GOSUB 13500:GOSUB 13100
  100. 13030 ask MOUSE x5%,y5%,b5%
  101. 13040 IF b5%=0 THEN 13030
  102. 13050 colreg% = pixel (x5%,y5%)
  103. 13055 CLOSE #1:cmd #0:pena colreg%
  104. 13060 b%=0:GOTO 20000
  105. 13100 talk$ = TRANSLATE$("PICK A COLOR")
  106. 13110 q% = narrate (talk$)
  107. 13120 RETURN
  108. 13500 n% = 10
  109. 13510 FOR y%=0 TO 3
  110. 13520 FOR x%=0 TO 7
  111. 13530 pena x%+(8*y%)
  112. 13540 a% = x%*n%
  113. 13550 b% = y%*n%
  114. 13560 peno 1
  115. 13570 box(a%,b%;a%+n%,b%+n%),1
  116. 13580 NEXT x%,y%
  117. 13590 RETURN
  118. 13999 REM **** FILL ROUTINE ****
  119. 14000 talk$=TRANSLATE$("SELLECT A POINT, AND PRESS BUTTIN!"):q% = narrate(talk$)
  120. 14010 ask MOUSE x%,y%,b%:GOSUB 50000
  121. 14020 GET a$:IF a$="C" OR a$="c" THEN GOSUB 13000:GOTO 14010
  122. 14025 IF a$<>"" THEN 20000
  123. 14030 IF b%=0 THEN 14010
  124. 14040 PAINT (x%,y%),1
  125. 14050 GOTO 14010
  126. 14999 REM **** SAVE SCREEN ROUTINE ****
  127. 15000 REM
  128. 15010 i%=narrate("PLEY4S DHAX MAW3S AET DHAX TAA4P LEH4FT KOH4RNER",n%())
  129. 15020 ask MOUSE x1%,y1%,b%:x%=x1%:y%=y1%:GOSUB 50000
  130. 15022 gosub 55000:x3%=x1%:y3%=y1%
  131. 15025 IF a$<>"" THEN x1%=0:y1%=0:x2%=303:y2%=187:GOTO 15070
  132. 15040 i%=narrate("PLEY4S DHAX MAW3S AET DHAX BAA4TAHM RAY3T KOH4RNER",n%())
  133. 15050 ask MOUSE x2%,y2%,b%:x%=x2%:y%=y2%:GOSUB 50000
  134. 15060 gosub 56000:x1%=x3%:y1%=y3%
  135. 15065 drawmode 0
  136. 15070 ERASE picture%
  137. 15080 size% = INT(((x2%-x1%)/16)+2)
  138. 15090 size% = size%*(y2%-y1%)
  139. 15100 size% = ((((size%*5)+4)/2)+10)
  140. 15110 DIM picture%(size%)
  141. 15120 sshape (x1%,y1%;x2%,y2%),picture%()
  142. 15130 WINDOW #1,10,50,300,35,"   SAVE    "
  143. 15140 cmd #1:graphic 0
  144. 15150 PRINT "SIZE= ";size%:INPUT "Enter a Filename: ";filename$
  145. 15160 CLOSE #1:cmd #0:graphic 1
  146. 15165 IF filename$="" THEN 15400
  147. 15170 bsave filename$,VARPTR(picture%(0)),4*size%
  148. 15180 colorfile$=filename$+"_dat"
  149. 15190 ct=0
  150. 15200 FOR i%=0 TO 31
  151. 15210 ask rgb i%,red%,green%,blue%
  152. 15220 regsave%(ct)=red%:regsave%(ct+1)=green%:regsave%(ct+2)=blue%
  153. 15230 ct=ct+3
  154. 15240 NEXT i%
  155. 15250 bsave colorfile$,VARPTR(regsave%(0)),400
  156. 15400 GOTO 20000
  157. 15999 REM **** I QUIT ****
  158. 16000 talk$=TRANSLATE$("I QUIT!"):q% = narrate(talk$)
  159. 16010 SCREEN 0,4:rgb 15,0,0,0:END
  160. 16999 REM **** LOAD A SHAPE ****
  161. 17000 WINDOW #1,10,50,300,25,"    LOAD    "
  162. 17010 cmd #1
  163. 17020 INPUT "Enter a filename: ";filename$
  164. 17030 CLOSE #1:cmd #0
  165. 17035 IF filename$ = "" THEN 20000
  166. 17040 talk$=TRANSLATE$("PLACE POINTER WHERE YOU WANT PICTURE TO GO!")
  167. 17050 q% = narrate(talk$)
  168. 17060 ask MOUSE x1%,y1%,b%:GOSUB 50000
  169. 17062 gosub 55000:x%=x2%:y%=y2%:drawmode 0
  170. 17065 IF a$<>"" THEN x%=0:y%=0:GOTO 17080
  171. 17080 ERASE picture%:DIM picture%(11000)
  172. 17085 ON ERROR GOTO 60000
  173. 17090 bload filename$,VARPTR(picture%(0))
  174. 17100 gshape (x%,y%),picture%()
  175. 17110 colorfile$=filename$+"_dat"
  176. 17120 bload colorfile$,VARPTR(regsave%(0))
  177. 17130 ct=0
  178. 17140 FOR i%=0 TO 31
  179. 17150 rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  180. 17160 ct=ct+3
  181. 17170 NEXT i%
  182. 17400 ON ERROR GOTO 0:GOTO 20000
  183. 20000 talk$ = TRANSLATE$("DONE?"):q% = narrate(talk$)
  184. 20005 drawmode 0
  185. 20010 ON ERROR GOTO 0:RETURN
  186. 20999 REM **** SHOW X & Y ****
  187. 21000 IF FLAG% = 0 THEN GOSUB 22000:RETURN
  188. 21010 FLAG% = 0:CLOSE #2:cmd #0:RETURN
  189. 22000 FLAG% = 1
  190. 22010 WINDOW #2,184,169,136,31," X & Y "
  191. 22030 cmd #0:RETURN
  192. 25000 talk$=TRANSLATE$("CYEKLE COLORS!"):q%=narrate(talk$)
  193. 25010 WINDOW #1,0,20,300,50,"  CYCLE COLORS   "
  194. 25020 cmd #1
  195. 25030 INPUT "Starting color register #: ";first%
  196. 25040 INPUT "Ending color register #:   ";last%
  197. 25050 IF first%>last% THEN GOTO 25030
  198. 25055 INPUT "Speed of rotation: ";speed%
  199. 25060 CLOSE #1:cmd #0
  200. 25070 ask rgb first%,r%,g%,b%
  201. 25080 FOR i%=last% TO first% STEP -1
  202. 25090 ask rgb i%,r1%,g1%,b1%
  203. 25100 rgb i%,r%,g%,b%
  204. 25110 r%=r1%:g%=g1%:b%=b1%
  205. 25120 ask MOUSE x%,y%,button%:IF button%=4 THEN GOTO 25200
  206. 25125 SLEEP(speed%)
  207. 25130 NEXT i%
  208. 25140 GOTO 25070
  209. 25200 ct=0
  210. 25210 FOR i% = 0 TO 31
  211. 25220 rgb i%,regsave%(ct),regsave%(ct+1),regsave%(ct+2)
  212. 25230 ct=ct+3
  213. 25240 NEXT i%
  214. 25250 GOTO 20000
  215. 29999 REM **** MENU ****
  216. 30000 WINDOW #1,0,0,190,187,"   MENU    "
  217. 30001 graphic 0:get a$:get a$
  218. 30002 cmd #1
  219. 30004 ? " "
  220. 30010 for i%=1 to 19:? name$(i%):next i%
  221. 30015 storey%=1
  222. 30020 ask mouse x%,y%,b%
  223. 30022 sleep (50000)
  224. 30025 if y%<8 or y%>160 or x%<0 or x%>150 then 30020
  225. 30030 cur%=int(y%/8):if cur%<1 or cur%>18 then 30045
  226. 30035 if cur%<>storey% then print at(0,storey%+1);name$(storey%);
  227. 30040 if cur%<>storey% then print at(0,cur%+1);inverse(1) name$(cur%);:storey%=cur%
  228. 30045 ask mouse x%,y%,b%
  229. 30050 if y%<8 or y%>152 or x%<0 or x%>150 then 30045
  230. 30054 if b%=4 then 30060
  231. 30055 goto 30030
  232. 30060 a$=mid$(name$(cur%),2,2)
  233. 30110 CLOSE #1:cmd #0:graphic 1:RETURN
  234. 34999 REM **** CIRCLE ****
  235. 35000 talk$ = TRANSLATE$("CIRCLE!"):q% = narrate(talk$)
  236. 35010 GOSUB 35070
  237. 35040 IF a$<>"" THEN 20000
  238. 35060 GOTO 35010
  239. 35070 drawmode 2
  240. 35080 ask MOUSE x1%,y1%,b%:GOSUB 50000
  241. 35090 gosub 55000
  242. 35095 if a$<>"" then return
  243. 35100 x2% = x1% : y2% = y1%
  244. 35110 ask MOUSE x%,y%,b%:GOSUB 50000
  245. 35120 IF x% = x2% AND y% = y2% GOTO 35110
  246. 35130 IF b%=0 THEN 35180
  247. 35140 CIRCLE (x1%,y1%),ABS(x2%-x1%)
  248. 35150 x2% = x% : y2% = y%
  249. 35160 CIRCLE (x1%,y1%),ABS(x2%-x1%)
  250. 35170 IF b% <> 0 GOTO 35110
  251. 35180 drawmode 0
  252. 35190 peno colreg%:CIRCLE (x1%,y1%),ABS(x2%-x1%)
  253. 35200 RETURN
  254. 35999 REM **** ELLIPSE ****
  255. 36000 talk$ = TRANSLATE$("ELIPSE!"):q% = narrate(talk$)
  256. 36010 GOSUB 36070
  257. 36040 IF a$<>"" THEN 20000
  258. 36060 GOTO 36010
  259. 36070 drawmode 2
  260. 36080 ask MOUSE x1%,y1%,b%:GOSUB 50000
  261. 36090 gosub 55000
  262. 36095 if a$<>"" then return
  263. 36100 x2% = x1% : y2% = y1%
  264. 36110 ask MOUSE x%,y%,b%:GOSUB 50000
  265. 36120 IF x% = x2% AND y% = y2% GOTO 36110
  266. 36130 IF b%=0 THEN 36180
  267. 36140 CIRCLE (x1%,y1%),ABS(x2%-x1%),ABS(y2%-y1%)/20
  268. 36150 x2% = x% : y2% = y%
  269. 36160 CIRCLE (x1%,y1%),ABS(x2%-x1%),ABS(y2%-y1%)/20
  270. 36170 IF b% <> 0 GOTO 36110
  271. 36180 drawmode 0
  272. 36190 peno colreg%:CIRCLE (x1%,y1%),ABS(x2%-x1%),ABS(y2%-y1%)/20
  273. 36200 RETURN
  274. 36999 REM **** RAYS ****
  275. 37000 talk$ = TRANSLATE$("RAYS!"):q% = narrate(talk$)
  276. 37010 GOSUB 37070
  277. 37020 ask MOUSE x%,y%,b%:GOSUB 50000
  278. 37030 GET a$:IF a$="C" OR a$="c" THEN GOSUB 13000:GOTO 37020
  279. 37040 IF a$<>"" THEN 20000
  280. 37050 IF b% = 0 GOTO 37020
  281. 37060 GOTO 37010
  282. 37070 drawmode 0
  283. 37080 ask MOUSE x1%,y1%,b%:GOSUB 50000
  284. 37090 IF b% = 0 GOTO 37080
  285. 37100 x2% = x1% : y2% = y1%
  286. 37110 ask MOUSE x%,y%,b%:GOSUB 50000
  287. 37120 IF x% = x2% AND y% = y2% GOTO 37110
  288. 37130 IF b%=0 THEN 37180
  289. 37140 draw (x1%,y1% TO x2%,y2%)
  290. 37150 x2% = x% : y2% = y%
  291. 37160 draw (x1%,y1% TO x2%,y2%)
  292. 37170 IF b% <> 0 GOTO 37110
  293. 37180 drawmode 0
  294. 37200 RETURN
  295. 40000 REM **** COPY SHAPE ****
  296. 40010 i%=narrate("PLEY4S DHAX MAW3S AET DHAX TAA4P LEH4FT KOH4RNER",n%())
  297. 40020 ask MOUSE x1%,y1%,b%:x%=x1%:y%=y1%:GOSUB 50000
  298. 40030 gosub 55000:x3%=x2%:y3%=y2%
  299. 40035 if a$<>"" then goto 40130
  300. 40040 i%=narrate("PLEY4S DHAX MAW3S AET DHAX BAA4TAHM RAY3T KOH4RNER",n%())
  301. 40050 ask MOUSE x2%,y2%,b%:x%=x2%:y%=y2%:GOSUB 50000
  302. 40060 gosub 56000:x1%=x3%:y1%=y3%
  303. 40065 drawmode 0
  304. 40070 ERASE picture%
  305. 40080 size% = INT(((x2%-x1%)/16)+2)
  306. 40090 size% = size%*(y2%-y1%)
  307. 40100 size% = ((((size%*5)+4)/2)+10)
  308. 40110 DIM picture%(size%)
  309. 40120 sshape (x1%,y1%;x2%,y2%),picture%()
  310. 40130 talk$=TRANSLATE$("SHAPE IS NOW READY TO USE!"):q% = narrate(talk$)
  311. 40140 ask MOUSE x%,y%,b%:GOSUB 50000
  312. 40150 GET a$:IF a$<>"" THEN 20000
  313. 40160 IF b%=0 THEN 40140
  314. 40170 gshape (x%,y%),picture%()
  315. 40180 GOTO 40140
  316. 41000 REM **** TEXT ROUTINE ****
  317. 41005 drawmode 0
  318. 41010 IF b$="B" OR b$="b" THEN GOSUB 41100
  319. 41020 IF b$="S" OR b$="s" THEN GOSUB 41500
  320. 41030 GOTO 20000
  321. 41100 talk$=TRANSLATE$("BIG TEXT!"):q%=narrate(talk$)
  322. 41110 ask MOUSE x%,y%,b%:GOSUB 50000
  323. 41115 gosub 55000:xo%=x1%:yo%=y1%-10:drawmode 0
  324. 41117 sleep(100000)
  325. 41120 GET alpha$:IF alpha$<>"" THEN IF ASC(alpha$)=13 THEN 41110
  326. 41121 if alpha$<>"" then if asc(alpha$)=227 or asc(alpha$)=195 then gosub 13000:alpha$=""
  327. 41125 if alpha$<>"" then gosub 42000
  328. 41128 ask mouse x%,y%,b%
  329. 41130 if b%=0 then 41120
  330. 41140 RETURN
  331. 41500 talk$=TRANSLATE$("SMALL TEXT!"):q%=narrate(talk$)
  332. 41510 graphic 1
  333. 41520 ask MOUSE x%,y%,b%:GOSUB 50000:graphic 1
  334. 41525 gosub 55000:x3%=x1%:y3%=y1%:drawmode 0
  335. 41526 sleep (100000)
  336. 41530 GET alpha$:IF alpha$<>"" THEN IF ASC(alpha$)=13 THEN 41520
  337. 41531 if alpha$<>"" then if asc(alpha$)=227 or asc(alpha$)=195 then gosub 13000:alpha$=""
  338. 41535 if alpha$<>"" then print at(x3%,y3%);alpha$:x3%=x3%+8
  339. 41538 ask mouse x1%,y1%,b%
  340. 41540 IF b%=0 THEN 41530
  341. 41550 graphic 0:RETURN
  342. 42000 REM plot alpha$ BIG
  343. 42020 sshape (xo%,yo%;12+xo%,yo%+12),img1%()
  344. 42030 soffset%=6:COLOR%=colreg%
  345. 42040 v%=vcset%+4+(ASC(alpha$)-32)*24
  346. 42050 WHILE COLOR%<>0
  347. 42060 IF (COLOR% MOD 2)=1 THEN FOR sk%=0 TO 23 STEP 4:POKE_l vimg1%+soffset%+sk%,PEEK_l(v%+sk%):NEXT
  348. 42070 COLOR%=INT(COLOR%/2)
  349. 42080 soffset%=soffset%+24
  350. 42090 WEND
  351. 42100 gshape (xo%,yo%),img1%()
  352. 42105 xo%=xo%+13
  353. 42110 RETURN
  354. 50000 IF FLAG% = 0 THEN RETURN
  355. 50010 COUNT% = COUNT% +1:IF COUNT% < 200 THEN RETURN
  356. 50020 COUNT% = 0:GOSUB 51000
  357. 50030 RETURN
  358. 51000 cmd #2:graphic 0:PRINT at(0,0);"X= ";:PRINT USING "###";x%;:PRINT "  Y= ";:PRINT USING "###";y%;
  359. 51010 cmd #0
  360. 51015 graphic 1
  361. 51020 RETURN
  362. 52000 WINDOW #1,0,0,320,200,"     R G B  MIXER      ":cmd #1
  363. 52010 graphic 1
  364. 52020 ask rgb colreg%,red%,green%,blue%
  365. 52030 pena colreg%: peno 1
  366. 52040 box(10,25;298,110),1
  367. 52050 RESTORE 52170
  368. 52060 FOR j%=1 TO 3
  369. 52070 READ a%,b%,c%
  370. 52080 pena a%
  371. 52090 AREA(c%+10,120 TO c%+0,130 TO c%+20,130)
  372. 52100 draw(c%+0,131 TO c%+20,131),1
  373. 52110 pena b%
  374. 52120 AREA(c%+0,135 TO c%+10,145 TO c%+20,135)
  375. 52130 draw(c%+0,134 TO c%+20,134),1
  376. 52140 pena 5
  377. 52150 AREA (c%+9,148 TO c%+9,163 TO c%+4,163 TO c%+10,166 TO c%+16,163 TO c%+11,163 TO c%+11,148)
  378. 52160 NEXT j%
  379. 52170 DATA 8,9,70,10,11,147,12,13,222
  380. 52180 GOSUB 52540:GOSUB 52620:GOSUB 52700
  381. 52190 CIRCLE (10,181),5:pena 2:PAINT (10,181),0
  382. 52200 pena 4:PRINT at(19,185); "= QUIT";
  383. 52210 n%=10:n1%=18
  384. 52220 FOR y%=0 TO 1
  385. 52230 FOR x%=0 TO 15
  386. 52240 pena x%+(16*y%)
  387. 52250 a% = (x%*n1%)+10
  388. 52260 b% = y%*n%
  389. 52270 peno 1
  390. 52280 box(a%,b%;a%+n1%,b%+n%),1
  391. 52290 NEXT x%,y%
  392. 52300 done% = 1
  393. 52310 WHILE done% = 1
  394. 52320 pena 6
  395. 52330 ask MOUSE x%,y%,button%
  396. 52340 IF button% = 4 AND y% < 20 THEN GOSUB 52720
  397. 52350 IF button% = 4 AND y% > 20 THEN GOSUB 52430
  398. 52360 WEND
  399. 52370 peno 0
  400. 52380 FOR i%=0 TO 93
  401. 52390 box(0+i%,0+i%;316-i%,187-i%),0
  402. 52400 SLEEP(5000)
  403. 52410 NEXT i%
  404. 52420 graphic 0:CLOSE #1:cmd #0:GOSUB 52780:RETURN
  405. 52430 colr% = pixel(x%,y%)
  406. 52440 IF colr% >= 8 AND colr% <= 13 THEN ON colr%-7 GOSUB 52480,52510,52560,52590,52640,52670
  407. 52450 SLEEP(100000)
  408. 52460 IF colr% = 2 THEN done% = 0
  409. 52470 RETURN
  410. 52480 REM *** inc. red ***
  411. 52490 red% = red% + 1:IF red% > 15 THEN red% = 15
  412. 52500 GOTO 52530
  413. 52510 REM *** dec. red ***
  414. 52520 red% = red% - 1:IF red% < 0 THEN red% = 0
  415. 52530 rgb colreg%,red%,green%,blue%
  416. 52540 pena 8:PRINT at((10+70)-7,180);:PRINT USING "##";red%
  417. 52550 RETURN
  418. 52560 REM *** inc. green ***
  419. 52570 green% = green% + 1:IF green% > 15 THEN green% = 15
  420. 52580 GOTO 52610
  421. 52590 REM *** dec. green ***
  422. 52600 green% = green% - 1:IF green% < 0 THEN green% = 0
  423. 52610 rgb colreg%,red%,green%,blue%
  424. 52620 pena 4:PRINT at((10+147)-7,180);:PRINT USING "##";green%
  425. 52630 RETURN
  426. 52640 REM *** inc. blue ***
  427. 52650 blue% = blue% + 1:IF blue% > 15 THEN blue% = 15
  428. 52660 GOTO 52690
  429. 52670 REM *** dec. blue ***
  430. 52680 blue% = blue% - 1:IF blue% < 0 THEN blue% = 0
  431. 52690 rgb colreg%,red%,green%,blue%
  432. 52700 pena 12:PRINT at((10+222)-7,180);:PRINT USING "##";blue%
  433. 52710 RETURN
  434. 52720 colreg% = pixel (x%,y%)
  435. 52730 pena colreg%:peno 1
  436. 52740 box(10,25;298,110),1
  437. 52750 ask rgb colreg%,red%,green%,blue%
  438. 52760 GOSUB 52540:GOSUB 52620:GOSUB 52700
  439. 52770 RETURN
  440. 52780 ct=0
  441. 52790 FOR i%=0 TO 31
  442. 52800 ask rgb i%,red%,green%,blue%
  443. 52810 regsave%(ct)=red%:regsave%(ct+1)=green%:regsave%(ct+2)=blue%
  444. 52820 ct=ct+3
  445. 52830 NEXT i%
  446. 52840 bsave colorfile$,VARPTR(regsave%(0)),400
  447. 52850 RETURN
  448. 55000 REM **** CROSS HAIR ****
  449. 55010 drawmode 2
  450. 55020 x2%=x1%:y2%=y1%
  451. 55030 draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%)
  452. 55040 ask MOUSE x%,y%,b%:GOSUB 50000
  453. 55045 get a$:if a$="C" or a$="c" then gosub 13000:drawmode 2:goto 55040
  454. 55046 if a$<>"" then b%=4
  455. 55050 IF b%<>0 THEN draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%):x1%=x2%:y1%=y2%:RETURN
  456. 55060 IF x%=x2% AND y%=y2% THEN 55040
  457. 55070 draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%)
  458. 55080 x2%=x%:y2%=y%
  459. 55090 draw(x2%,0 TO x2%,187):draw(0,y2% TO 317,y2%)
  460. 55100 GOTO 55040
  461. 56000 REM **** BOX SHADOW ****
  462. 56010 drawmode 2
  463. 56030 box (x1%,y1%;x2%,y2%)
  464. 56040 ask mouse x%,y%,b%:gosub 50000
  465. 56050 if b%<>0 then box (x1%,y1%;x2%,y2%):x2%=x2%+1:y2%=y2%+1:return
  466. 56060 if x%=x2% and y%=y2% then 56040
  467. 56070 box (x1%,y1%;x2%,y2%)
  468. 56080 x2%=x%:y2%=y%
  469. 56090 box (x1%,y1%;x2%,y2%)
  470. 56100 goto 56040
  471. 58000 restore 58050
  472. 58010 for i%=1 to 19:read name$(i%):next i%:return
  473. 58050 data " A... Alter Colors"," B... Box"," C... Change Color"," D... Draw"," E... Ellipse"," F... Fill"," K... Load"," L... Line"
  474. 58052 data " M... Cycle Colors"," O... Circle"," Q... Quit"," R... Rays"," S... Save"," TB.. Big Text"," TS.. Small Text"
  475. 58054 data " U... Clear Screen"," X... Copy Shape"," Z... Show X & Y"," ?... This Menu"
  476. 60000 RESUME 17400
  477. 60010 colreg%=1:talk$=TRANSLATE$("TRY AGAIN!"):q%=narrate(talk$)
  478. 60020 RESUME 13120
  479. 61000 scnclr
  480. 61010 get a$:if a$="" then 61010
  481. 61015 ? asc(a$);",";
  482. 61020 goto 61010
  483.